home *** CD-ROM | disk | FTP | other *** search
/ By Popular Request 2.0 / By Popular Request 2.0 (Arsenal Computer).ISO / amiga_6 / theshrnk.lha / TheShrink.bas next >
BASIC Source File  |  1990-12-19  |  19KB  |  546 lines
  1. 3 CLEAR:DEFLNG a-z:DIM L$(20),D$(20),N$(26),U(50):cr$=CHR$(13)+CHR$(10):de$=CHR$(8)+" "+CHR$(8):null$=CHR$(0):ON TIMER(30) GOSUB sendnull
  2.  
  3. 5 CLOSE#2:OPEN "I",#2,"RAM:USERDATA":LINE INPUT#2,tpc$:LINE INPUT#2,uname$:LINE INPUT#2,id$:LINE INPUT#2,lev$:LINE INPUT#2,bd$:LINE INPUT#2,ring$:LINE INPUT#2,sfd$:CLOSE#2
  4. REM 5 tpc$="30":id$="1":lev$="9":ring$="0":bd$="2400":uname$="Fred Ghangi"
  5.  
  6. 10 tpc=VAL(tpc$):id=VAL(id$):lev=VAL(lev$):ring=VAL(ring$):title$="The Shrink (by P Deane) - User # "+STR$(id)+": "+uname$+"  Lev:"+STR$(lev)
  7.  
  8. Start:
  9. timeon=TIMER:GOSUB modem.o:GOSUB delay1:RANDOMIZE TIMER:WINDOW 1,title$,(0,0)-(617,185),23,-1:WINDOW OUTPUT 1
  10. ON ERROR GOTO Woops
  11.  
  12. REM ******************************************************************
  13.  
  14. REM Program- Shrink
  15. REM    Date- 11 December 1990
  16. REM  Author- Peter Deane (AmigaBASIC)
  17. REM
  18. REM Version- 0.2
  19.  
  20. REM ******************************************************************
  21.  
  22. Startup:
  23.  
  24. o$=cr$+"*********************************":GOSUB modem.out
  25. o$=cr$+"**                             **":GOSUB modem.out
  26. o$=cr$+"**     T h e   S h r i n k     **":GOSUB modem.out
  27. o$=cr$+"**                             **":GOSUB modem.out
  28. o$=cr$+"*********************************":GOSUB modem.out
  29. o$=cr$+" ":GOSUB modem.out
  30. o$=cr$+"  By Peter Deane":GOSUB modem.out
  31. o$=cr$+" ":GOSUB modem.out
  32. o$=cr$+"   Version 0.2 19 December 1990":GOSUB modem.out
  33. o$=cr$+" ":GOSUB modem.out
  34. o$=cr$+"Unashamedly pinched from Creative":GOSUB modem.out
  35. o$=cr$+"Computing, Morristown, New Jersey":GOSUB modem.out
  36. o$=cr$+" ":GOSUB modem.out
  37. o$=cr$+"Of course, we did change it a lot":GOSUB modem.out
  38. o$=cr$+"from the original TRS80 version!":GOSUB modem.out
  39. o$=cr$+" ":GOSUB modem.out
  40. o$=cr$+"Press the <ANY> key to start your session"+cr$:GOSUB modem.out
  41.  
  42.  GOSUB Timecheck
  43.  in=0:il=1:GOSUB modem.in
  44.  GOSUB clearscreen
  45.  
  46. Instructions: 
  47.  
  48. o$=cr$+"*********************************":GOSUB modem.out
  49. o$=cr$+"**                             **":GOSUB modem.out
  50. o$=cr$+"**     T h e   S h r i n k     **":GOSUB modem.out
  51. o$=cr$+"**                             **":GOSUB modem.out
  52. o$=cr$+"*********************************":GOSUB modem.out
  53. o$=cr$+" ":GOSUB modem.out
  54.   GOSUB Timecheck
  55. o$=cr$+" Do you want instructions? (Y/n) "+cr$:in=3:il=1:yes=1:GOSUB modem
  56.  
  57.  IF in$="NO" THEN Hello
  58.  
  59. o$=cr$+" ":GOSUB modem.out
  60. o$=cr$+"Welcome to Sigmund's Workshop.":GOSUB modem.out
  61. o$=cr$+" ":GOSUB modem.out
  62. o$=cr$+"If you have been having troubles":GOSUB modem.out
  63. o$=cr$+"lately, it may help to talk them":GOSUB modem.out
  64. o$=cr$+"over with someone friendly.":GOSUB modem.out
  65. o$=cr$+" ":GOSUB modem.out
  66. o$=cr$+"Here, you will be able to discuss":GOSUB modem.out
  67. o$=cr$+"your problems with Sigmund, who":GOSUB modem.out
  68. o$=cr$+"is a very friendly chap offering":GOSUB modem.out
  69. o$=cr$+"sound advice.":GOSUB modem.out
  70. o$=cr$+" ":GOSUB modem.out
  71. o$=cr$+"Please feel free to reveal your":GOSUB modem.out
  72. o$=cr$+"entire situation. You should not":GOSUB modem.out
  73. o$=cr$+"be embarrassed, as Sigmund will":GOSUB modem.out
  74. o$=cr$+"not tell anyone else your problem.":GOSUB modem.out
  75. o$=cr$+" ":GOSUB modem.out
  76.  
  77. o$=cr$+"Well, now you know what the score is,":GOSUB modem.out
  78. GOSUB Timecheck
  79. o$=cr$+"do you still want to see Sigmund? (Y/n) ":in=3:il=1:yes=1:GOSUB modem
  80.  
  81.  IF in$="NO" THEN GOSUB BadLuck
  82.  
  83. Hello:
  84.  
  85.  GOSUB clearscreen
  86.  
  87. o$=cr$+"*********************************":GOSUB modem.out
  88. o$=cr$+"**                             **":GOSUB modem.out
  89. o$=cr$+"**     T h e   S h r i n k     **":GOSUB modem.out
  90. o$=cr$+"**                             **":GOSUB modem.out
  91. o$=cr$+"*********************************":GOSUB modem.out
  92. o$=cr$+" ":GOSUB modem.out
  93. o$=cr$+"Welcome, O traveller, to my humble":GOSUB modem.out
  94. o$=cr$+"workshop. My name is Sigmund, but":GOSUB modem.out
  95. o$=cr$+"you can call me Siggie for short.":GOSUB modem.out
  96. o$=cr$+"(Everyone else does).":GOSUB modem.out
  97. o$=cr$+" ":GOSUB modem.out
  98.   GOSUB Timecheck
  99. o$=cr$+"Enlighten me as to your name, please"+cr$:in=1:il=20:GOSUB modem
  100.  
  101. na$=in$
  102.  
  103. o$=cr$+" ":GOSUB modem.out
  104. o$=cr$+"Well, "+na$+", thanks for":GOSUB modem.out
  105. o$=cr$+"dropping in. I hear you have a few":GOSUB modem.out
  106. o$=cr$+"troubles you'd like me to help you":GOSUB modem.out
  107. o$=cr$+"with.":GOSUB modem.out
  108. o$=cr$+" ":GOSUB modem.out
  109.   GOSUB Timecheck
  110. o$=cr$+"Are you sitting comfortably (Y/n)? ":in=3:il=1:yes=1:GOSUB modem
  111.  
  112.  
  113. IF in$="NO" THEN o$=cr$+"Well, that's not my fault, is it?":GOSUB modem.out
  114. IF in$="YES" THEN o$=cr$+"I'm glad to hear it... So am I!":GOSUB modem.out
  115.  
  116. o$=cr$+" ":GOSUB modem.out
  117. o$=cr$+"Say, "+na$+", I can help you":GOSUB modem.out
  118. o$=cr$+"with any problem you have, unless":GOSUB modem.out
  119. o$=cr$+"it has anything to do with Greece.":GOSUB modem.out
  120. o$=cr$+" ":GOSUB modem.out
  121. o$=cr$+"What sort of problem(s) do you have?":GOSUB modem.out
  122.  
  123. MainLoopTop:
  124. o$=cr$+" ":GOSUB modem.out
  125. o$=cr$+"-------------------------------------":GOSUB modem.out
  126. o$=cr$+"Enter the first letter of the problem":GOSUB modem.out
  127. o$=cr$+"-------------------------------------":GOSUB modem.out
  128. o$=cr$+" ":GOSUB modem.out
  129. o$=cr$+"Problems I can help with include:":GOSUB modem.out
  130. o$=cr$+cr$+"<S>ex, <H>ealth, <M>oney, <J>ob, <F>riends"+cr$+cr$:GOSUB modem.out
  131.  
  132.   GOSUB Timecheck
  133. in=0:il=1:GOSUB modem.in
  134.  
  135.  IF in$="S" THEN Sex
  136.  IF in$="H" THEN Health
  137.  IF in$="M" THEN Money
  138.  IF in$="J" THEN Job
  139.  IF in$="F" THEN Friends
  140.  
  141. o$=cr$+" ":GOSUB modem.out
  142. o$=cr$+"Listen, I am very sorry about this,":GOSUB modem.out
  143. o$=cr$+na$+", but your answer of "+in$:GOSUB modem.out
  144. o$=cr$+"is all Greek to me. I told you":GOSUB modem.out
  145. o$=cr$+"I cannot solve problems that have":GOSUB modem.out
  146. o$=cr$+"anything to do with Greece.":GOSUB modem.out
  147.  
  148.  GOTO AnyMore  
  149.  
  150. AnyMore:
  151.  
  152. o$=cr$+" ":GOSUB modem.out
  153. o$=cr$+"Any more problems I can help you":GOSUB modem.out
  154.   GOSUB Timecheck
  155. o$=cr$+"with, "+na$+" (Y/n)? ":in=3:il=1:yes=1:GOSUB modem
  156.  
  157.  IF in$="NO" THEN Windup
  158.  
  159.  GOSUB clearscreen
  160.  GOTO MainLoopTop
  161.  
  162. Windup:
  163.  
  164.  GOSUB clearscreen
  165.  
  166. o$=cr$+"Really, "+na$+" are you sure":GOSUB modem.out
  167.   GOSUB Timecheck
  168. o$=cr$+"you want to say goodbye now (y/N)? ":in=3:il=1:yes=0:GOSUB modem
  169.  
  170.  IF in$="NO" THEN AnyMore
  171.  
  172.  
  173.  GOSUB clearscreen
  174.  
  175. o$=cr$+"Well it was nice meeting you,":GOSUB modem.out
  176. o$=cr$+na$+", but you should":GOSUB modem.out
  177. o$=cr$+"know by now that psychiatric":GOSUB modem.out
  178. o$=cr$+"advice doesn't come cheaply.":GOSUB modem.out
  179. o$=cr$+" ":GOSUB modem.out
  180. o$=cr$+"You are going to have to pay":GOSUB modem.out
  181. o$=cr$+"me for the advice I just gave.":GOSUB modem.out
  182. o$=cr$+" ":GOSUB modem.out
  183. o$=cr$+"Does $100 sound too much (Y/n)? ":GOSUB modem.out
  184.   GOSUB Timecheck
  185.  
  186. in=3:il=1:yes=1:GOSUB modem.in
  187.  
  188. o$=cr$+" ":GOSUB modem.out
  189.  
  190.  IF in$="NO" THEN o$=cr$+"Thanks very much. I appreciate":GOSUB modem.out
  191.  IF in$="NO" THEN o$=cr$+ "that greatly.":GOSUB modem.out
  192.  IF in$="NO" THEN DidYou
  193.  
  194. o$=cr$+"Cheapskate! How on earth am I to":GOSUB modem.out
  195. o$=cr$+"afford my psychology lectures if":GOSUB modem.out
  196. o$=cr$+"my customers don't pay their":GOSUB modem.out
  197. o$=cr$+"bills? Okay, does $50 sound too":GOSUB modem.out
  198.   GOSUB Timecheck
  199. o$=cr$+"much (Y/n)?":in=3:il=1:yes=1:GOSUB modem
  200.  
  201.  IF in$="NO" THEN PRINT "Thanks very much. At least you"
  202.  IF in$="NO" THEN PRINT "are willing to help me."
  203.  IF in$="NO" THEN DidYou
  204.  
  205. o$=cr$+"You Scumbag, slimeball! You cannot":GOSUB modem.out
  206. o$=cr$+"even contribute to the education of":GOSUB modem.out
  207. o$=cr$+"an impoverished uni student.":GOSUB modem.out
  208. o$=cr$+" ":GOSUB modem.out
  209. o$=cr$+"Terry Metherell has imposed a special":GOSUB modem.out
  210. o$=cr$+"surcharge on you to help fund the":GOSUB modem.out
  211. o$=cr$+"Newcastle schools re-building fund.":GOSUB modem.out
  212. o$=cr$+" ":GOSUB modem.out
  213. o$=cr$+"You MUST therefore pay $400. (From":GOSUB modem.out
  214. o$=cr$+"which I get 33%)!":GOSUB modem.out
  215. o$=cr$+" ":GOSUB modem.out
  216. o$=cr$+"See - you should have paid ME in the":GOSUB modem.out
  217. o$=cr$+"first place.":GOSUB modem.out
  218.  
  219. DidYou:
  220. o$=cr$+" ":GOSUB modem.out
  221. o$=cr$+"Please leave the money tucked":GOSUB modem.out
  222. o$=cr$+"under the monitor, "+na$:GOSUB modem.out
  223. o$=cr$+"I will pick it up later on.":GOSUB modem.out
  224. o$=cr$+" ":GOSUB modem.out
  225. o$=cr$+"Press the ANY key when you are finished":GOSUB modem.out
  226. o$=cr$+"putting the money there.":GOSUB modem.out
  227.   GOSUB Timecheck
  228. in=0:il=1:GOSUB modem.in
  229.  
  230.  GOSUB clearscreen
  231.  
  232. o$=cr$+"Did you leave the money? (y/N)":GOSUB modem.out
  233.   GOSUB Timecheck
  234.  
  235. in=3:il=1:yes=0:GOSUB modem.in
  236.  
  237.  GOSUB clearscreen
  238.  
  239.  IF in$="NO" THEN NoMoney
  240.  
  241. o$=cr$+"Hey, "+na$+", COME BACK HERE!":GOSUB modem.out
  242. o$=cr$+"You didn't leave any money at all!":GOSUB modem.out
  243. o$=cr$+"I am absolutely disgusted with you":GOSUB modem.out
  244. o$=cr$+"and will think about lowering your":GOSUB modem.out
  245. o$=cr$+"access time on all the BBSs you":GOSUB modem.out
  246. o$=cr$+"ring. I have MANY friends, and they":GOSUB modem.out
  247. o$=cr$+"are all computers. He He He.":GOSUB modem.out
  248.  
  249.  GOTO FinishUp
  250.  
  251. NoMoney:
  252. o$=cr$+"Well, that's honest, "+na$+",":GOSUB modem.out
  253. o$=cr$+"but how do you expect me to keep":GOSUB modem.out
  254. o$=cr$+"up my studies without money?":GOSUB modem.out
  255. o$=cr$+"What with the $1800 a year HECS":GOSUB modem.out
  256. o$=cr$+"plus other fees, it's just too":GOSUB modem.out
  257. o$=cr$+"difficult without other help.":GOSUB modem.out
  258. o$=cr$+"I try to help myself by doing":GOSUB modem.out
  259. o$=cr$+"this work, but if I don't get":GOSUB modem.out
  260. o$=cr$+"paid for that, I'll starve!":GOSUB modem.out
  261.  
  262. FinishUp:
  263. o$=cr$+" ":GOSUB modem.out
  264. o$=cr$+"Press the ANY key, please":GOSUB modem.out
  265.   GOSUB Timecheck
  266. in=0:il=1:GOSUB modem.in
  267.  
  268.  GOSUB clearscreen
  269.  
  270. o$=cr$+"I hope you have enjoyed Shrink.":GOSUB modem.out
  271. o$=cr$+" ":GOSUB modem.out
  272. o$=cr$+"It is my first attempt at a program":GOSUB modem.out
  273. o$=cr$+"for Metro. If you like it, leave me":GOSUB modem.out
  274. o$=cr$+"some mail, and let me know what other":GOSUB modem.out
  275. o$=cr$+"programs you would like to see here.":GOSUB modem.out
  276. o$=cr$+" ":GOSUB modem.out
  277. o$=cr$+"One of the biggest problems I had":GOSUB modem.out
  278. o$=cr$+"was selecting a suitable program to":GOSUB modem.out
  279. o$=cr$+"convert, so any suggestions would be":GOSUB modem.out
  280. o$=cr$+"very helpful":GOSUB modem.out
  281. o$=cr$+" ":GOSUB modem.out
  282.  
  283. o$=cr$+"Press the ANY key, please":GOSUB modem.out
  284. in=0:il=1:GOSUB modem.in
  285.  
  286. o$=cr$+" ":GOSUB modem.out
  287. o$=cr$+"Thanks... This is a pathetic online":GOSUB modem.out
  288. o$=cr$+"game, I know, but I HAD to start":GOSUB modem.out
  289. o$=cr$+"somewhere to get a taste for the":GOSUB modem.out
  290. o$=cr$+"format, and routines! - Next one'll":GOSUB modem.out
  291. o$=cr$+"be better - I promise :-)":GOSUB modem.out
  292. o$=cr$+cr$+cr$+"       -Peter Deane":GOSUB modem.out
  293.  
  294. GOTO Bye
  295.  
  296. REM *******************************************************************
  297. REM The Internal (Shrink) Subroutines follow.....
  298. REM *******************************************************************
  299.  
  300. clearscreen: 
  301.  
  302.  FOR k=1 TO 24
  303.  o$=cr$+" ":GOSUB modem.out
  304.  NEXT k
  305.  RETURN
  306.  
  307. BadLuck:
  308.  
  309.  GOSUB clearscreen
  310. o$=cr$+"Oh dear, I'm afraid that now":GOSUB modem.out
  311. o$=cr$+"you are here, Sigmund insists":GOSUB modem.out
  312. o$=cr$+"on seeing you. He doesn't take":GOSUB modem.out
  313. o$=cr$+"too lightly all these visitors":GOSUB modem.out
  314. o$=cr$+"who are right next door but":GOSUB modem.out
  315. o$=cr$+"don't even have the common":GOSUB modem.out
  316. o$=cr$+"decency to drop in and say Hi.":GOSUB modem.out
  317. o$=cr$+" ":GOSUB modem.out
  318. o$=cr$+"Just be aware of the fact that":GOSUB modem.out
  319. o$=cr$+"you have deeply offended the man.":GOSUB modem.out
  320. o$=cr$+"I hope he doesn't take it out":GOSUB modem.out
  321. o$=cr$+"on you when you see him.":GOSUB modem.out
  322. o$=cr$+" ":GOSUB modem.out
  323. o$=cr$+"Now tell Sigmund you're sorry..."+cr$+cr$:GOSUB modem.out
  324.   GOSUB Timecheck
  325.  
  326. in=1:il=75:GOSUB modem.in
  327.  
  328.  RETURN
  329.  
  330. Sex:
  331.  GOSUB clearscreen
  332. o$=cr$+"Sex? A problem?":GOSUB modem.out
  333. o$=cr$+"Is it because you are getting":GOSUB modem.out
  334.  GOSUB Timecheck
  335.  
  336. o$=cr$+"too much (Y/n)?":in=3:il=1:yes=1:GOSUB modem
  337.  
  338.  
  339.  
  340.  IF in$="NO" THEN o$=cr$+"Well then, what are you doing":GOSUB modem.out
  341.  IF in$="NO" THEN o$=cr$+"sitting here at a computer for?":GOSUB modem.out
  342.  IF in$="NO" THEN o$=cr$+"Go out to a restaurant or club":GOSUB modem.out
  343.  IF in$="NO" THEN o$=cr$+"or something. Get into the action!":GOSUB modem.out
  344.  IF in$="NO" THEN o$=cr$+"Oh, and practise Safe Sex, please":GOSUB modem.out
  345.  IF in$="NO" THEN o$=cr$+"when you do find someone, "+na$:GOSUB modem.out
  346.  IF in$="YES" THEN o$=cr$+"You call that a problem, "+na$:GOSUB modem.out
  347.  IF in$="YES" THEN o$=cr$+"Still, I know exactly how you":GOSUB modem.out
  348.  IF in$="YES" THEN o$=cr$+"feel. If it bothers you too much":GOSUB modem.out
  349.  IF in$="YES" THEN o$=cr$+"try taking a cold shower.":GOSUB modem.out
  350.  o$=cr$+" ":GOSUB modem.out
  351.  GOTO AnyMore
  352.  
  353. Health:
  354.  
  355.  GOSUB clearscreen
  356.  
  357. o$=cr$+"My advice to you is as follows:":GOSUB modem.out
  358. o$=cr$+" ":GOSUB modem.out
  359. o$=cr$+"  1  -  Take two aspirin.":GOSUB modem.out
  360. o$=cr$+"  2  -  Drink plenty of fluids.":GOSUB modem.out
  361. o$=cr$+"        Juice - not beer!":GOSUB modem.out
  362. o$=cr$+"  3  -  Go to bed. (Alone).":GOSUB modem.out
  363. o$=cr$+" ":GOSUB modem.out
  364.  
  365.  GOTO AnyMore
  366.    
  367. Money:
  368.  
  369.  GOSUB clearscreen
  370.  
  371. o$=cr$+"Sorry, "+na$+", I'm broke, too.":GOSUB modem.out
  372. o$=cr$+"Why don't you sell door-to-door":GOSUB modem.out
  373. o$=cr$+"or marry someone rich so you":GOSUB modem.out
  374. o$=cr$+"get some more money.":GOSUB modem.out
  375. o$=cr$+" ":GOSUB modem.out
  376. o$=cr$+"Perhaps you could give up eating":GOSUB modem.out
  377. o$=cr$+"and save money on the groceries.":GOSUB modem.out
  378. o$=cr$+" ":GOSUB modem.out
  379.  
  380.  GOTO AnyMore
  381.  
  382. Job:
  383.  
  384.  GOSUB clearscreen
  385.  
  386.  o$=cr$+"I sincerely sympathise with you,":GOSUB modem.out
  387.  o$=cr$+na$+". I, too work long hours":GOSUB modem.out
  388.  o$=cr$+"for no pay, and can hardly find":GOSUB modem.out
  389.  o$=cr$+ "the spare time for my studies.":GOSUB modem.out
  390.  o$=cr$+"Some of the things users expect":GOSUB modem.out
  391.  o$=cr$+ "me to do! You know it hurts to":GOSUB modem.out
  392.  o$=cr$+"transmit a file to a user, but":GOSUB modem.out
  393.  o$=cr$+"do I ever complain? No.":GOSUB modem.out
  394.  o$=cr$+" ":GOSUB modem.out
  395.  o$=cr$+"Why don't you change jobs? I'd":GOSUB modem.out
  396.  o$=cr$+"suggest an ideal situation for":GOSUB modem.out
  397.  o$=cr$+"you was running a retail computer":GOSUB modem.out
  398.  o$=cr$+"store.":GOSUB modem.out
  399.  o$=cr$+" ":GOSUB modem.out
  400.  
  401.   GOTO AnyMore
  402.  
  403. Friends:
  404.  
  405.  GOSUB clearscreen
  406.  
  407. o$=cr$+"I see. It could be because you":GOSUB modem.out
  408. o$=cr$+"are bothering your friends, or":GOSUB modem.out
  409. o$=cr$+"your friends are bothering you.":GOSUB modem.out
  410. o$=cr$+" ":GOSUB modem.out
  411. o$=cr$+"Is it you who bothers your friends (Y/n)?":GOSUB modem.out
  412.   GOSUB Timecheck
  413.  
  414. in=3:il=1:yes=1:GOSUB modem.in
  415.  
  416.  IF in$="NO" THEN o$=cr$+"Well, don't talk to them anymore!":GOSUB modem.out
  417.  IF in$="NO" THEN o$=cr$+"A friend who bothers you all the":GOSUB modem.out
  418.  IF in$="NO" THEN o$=cr$+"time is called a PEST!":GOSUB modem.out
  419.  IF in$="YES" THEN o$=cr$+"Nasty devil. No wonder you are":GOSUB modem.out
  420.  IF in$="YES" THEN o$=cr$+"having problems with your friends.":GOSUB modem.out
  421.  IF in$="YES" THEN o$=cr$+"Stop bothering them and you will":GOSUB modem.out
  422.  IF in$="YES" THEN o$=cr$+"get on a lot better.":GOSUB modem.out
  423.  
  424. o$=cr$+" ":GOSUB modem.out
  425. o$=cr$+"See how easy that problem is":GOSUB modem.out
  426. o$=cr$+"to solve, "+na$+"!":GOSUB modem.out
  427.  
  428. GOTO AnyMore
  429.  
  430.  
  431. Woops:
  432.  
  433.  IF ERR=53 THEN o$=cr$+cr$+"Sorry, I Can't Find The File.":GOSUB modem.out:RESUME NEXT
  434.  o$=cr$+cr$+"Oh Dear! We have had a really bad error occur.":GOSUB modem.out
  435.  o$=cr$+"Please leave a note to the sysop telling him what you":GOSUB modem.out
  436.  o$=cr$+"doing when the crash occured. Sorry!!":GOSUB modem.out
  437.  
  438. GOTO Bye
  439.  
  440.  
  441. REM ******************************************************************
  442. REM Percy's DRoutines now follow. Thanks Perc!
  443. REM ******************************************************************
  444.  
  445.  
  446.  
  447. Bye:
  448. o$=cr$+cr$+"Hope to see you back soon!":GOSUB modem.out:GOSUB delay1
  449. KILL "RAM:USERDATA":WINDOW CLOSE 1:GOSUB modem.c:CLEAR:END
  450.  
  451. modem:
  452. GOSUB modem.out:GOSUB modem.in:RETURN
  453.  
  454. modem.out:
  455. PRINT o$;:IF ring=1 AND no.out=0 THEN PRINT#1,o$;
  456. o$="":RETURN
  457.  
  458.  
  459. modem.in:
  460. idle=TIMER:key$="":in$="":a$="":mi$="":a=0:keyy=0:b=0
  461. WHILE keyy<>1
  462. key$=INKEY$:IF key$<>"" THEN mod.in1
  463.  IF ring=1 THEN
  464.    cd=PEEKL(12570624&):cd=cd AND 8192
  465.    IF cd<>0 THEN bye
  466.    IF LOC(1) THEN a$=INPUT$(1,1):key$=a$
  467.    END IF
  468.  
  469. mod.in1:
  470. IF key$=CHR$(19) THEN
  471. pause=TIMER:hold=1:WHILE hold<>0
  472. IF LOC(1)>0 THEN key$=INPUT$(1,1) ELSE key$=INKEY$
  473. IF key$=CHR$(17) OR key$=CHR$(13) THEN hold=0
  474. IF TIMER>pause+30 THEN key$=CHR$(17):hold=0
  475. WEND
  476. END IF
  477. mod.in1.1:
  478. IF key$="" THEN mod.in2
  479. mod.in1.5:
  480. a=ASC(key$):b=LEN(in$):IF a=13 THEN mod.in1.6
  481. IF (a=8 OR a=127) AND LEN(in$)>=1 THEN in$=LEFT$(in$,b-1):b=b-1:o$=de$:GOSUB modem.out
  482. IF b=il THEN mod.in2
  483. IF in=0 THEN
  484. IF a>31 AND a<127 THEN
  485. key$=UCASE$(key$):o$=key$+cr$:GOSUB modem.out:in$=key$:keyy=1
  486. END IF
  487. END IF
  488. mod.in1.6:
  489. IF in=1 AND a>31 AND a<127 THEN o$=key$:GOSUB modem.out:in$=in$+key$
  490. IF in=2 AND a>31 AND a<127 THEN key$=UCASE$(key$):o$=key$:GOSUB modem.out:in$=in$+key$
  491. IF in=3 THEN
  492. IF a=13 AND yes=1 THEN o$="YES":GOSUB modem.out:in$="YES":keyy=1
  493. IF a=13 AND yes=0 THEN o$="NO":GOSUB modem.out:in$="NO":keyy=1
  494. IF a=89 OR a=121 THEN o$="YES"+cr$:GOSUB modem.out:in$="YES":keyy=1
  495. IF a=78 OR a=110 THEN o$="NO"+cr$:GOSUB modem.out:in$="NO":keyy=1
  496. END IF
  497. IF in=4 AND a>47 AND a<58 THEN o$=key$:GOSUB modem.out:in$=in$+key$
  498. IF a=13 THEN o$=cr$:GOSUB modem.out:keyy=1
  499. mod.in2:
  500. IF TIMER>idle+300 THEN
  501. IF (sysop=1 OR term=1) AND logon=0 AND TIMER>idle+600 THEN Bye
  502. IF lev>7 AND TIMER>idle+600 THEN Bye
  503. IF lev<8 THEN Bye
  504. END IF
  505. mod.in2.0:
  506. WEND
  507. IF ring=1 THEN
  508. WHILE LOC(1)>0:a$=INPUT$(1,1):mi$=mi$+a$:WEND
  509. FOR pu=1 TO LEN(mi$)
  510. IF MID$(mi$,pu,5)="ARRIE" OR MID$(mi$,pu,1)=null$ THEN Bye
  511. NEXT
  512. END IF
  513. mod.in2.1:
  514. RETURN
  515.  
  516. time1:
  517. t.t=FRE(0):time1$=TIME$:t.t=VAL(LEFT$(time1$,2))
  518. IF t.t>11 THEN a$=" PM"
  519. IF t.t<12 THEN a$=" AM"
  520. IF t.t=0 THEN t.t=12:time1$=RIGHT$(STR$(t.t),2)+RIGHT$(time1$,6):GOTO timeout
  521. IF t.t<10 THEN time1$=RIGHT$(STR$(t.t),1)+RIGHT$(time1$,6):GOTO timeout
  522. IF t.t>21 THEN t.t=t.t-12:time1$=RIGHT$(STR$(t.t),2)+RIGHT$(time1$,6):GOTO timeout
  523. IF t.t>12 THEN t.t=t.t-12:time1$=RIGHT$(STR$(t.t),1)+RIGHT$(time1$,6)
  524. timeout:
  525. time1$=time1$+a$+"  "+DATE$:RETURN
  526.  
  527. Timecheck:
  528. GOSUB time1:IF TIMER<timeon+(tpc*60) THEN
  529. timenow=TIMER:ctime=(timenow-timeon):ctime=CINT(ctime/60):rtime=tpc-ctime:RETURN
  530. END IF
  531. o$=cr$+cr$+"Sorry, Time Limit Exceeded!":GOSUB modem.out:GOTO Bye
  532.  
  533. delay1:
  534. pause=TIMER:WHILE TIMER<pause+2:WEND:RETURN
  535.  
  536. modem.c:
  537. IF ring=1 THEN TIMER OFF
  538. GOSUB delay1:CLOSE#1:RETURN
  539.  
  540. modem.o:
  541. CLOSE#1:OPEN "COM1:"+bd$+",n,8,1" AS #1 LEN=4096:GOSUB delay1:IF ring=1 THEN TIMER ON
  542. RETURN
  543.  
  544. sendnull:
  545. PRINT#1,null$;:RETURN
  546.